home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / crypt / tarchiv / tapearc.pas < prev    next >
Pascal/Delphi Source File  |  1995-01-27  |  13KB  |  431 lines
  1. { TAPEARC.TPU }
  2.  
  3. { Andreas Schiffler, U of S, 1994 }
  4.  
  5. { This unit derives a tape-archiver object from the archiver object which }
  6. { works with the EXB-8500 tape drive, i.e. uses ASPI.TPU. A lot of effort }
  7. { goes into error checking, but when the tape locks for more than TIMEOUT }
  8. { minutes the program will be aborted with a DOS error code 1.            }
  9.  
  10. Unit TapeArc;
  11.  
  12. interface
  13.  
  14. Uses Dos, Arc, Aspi, Logfile, ToolBox;
  15.  
  16. type
  17.   PTapeArchiver = ^TTapeArchiver;
  18.   TTapeArchiver = object (TArchiver)
  19.                     { Configure these externally }
  20.                     Timeout         : Byte;
  21.                     TapeKBytes      : Longint;
  22.                     KBytesThreshold : Longint;
  23.                     DoTime          : Boolean;
  24.                     { Wordy : Boolean;        }
  25.                     { DisplayFlag : Boolean;  }
  26.  
  27.                     { }
  28.                     DoReset    : Boolean;
  29.                     Tape       : PASPITape;
  30.                     SaveSet    : Word;
  31.                     StartBlock : Longint;
  32.                     DoErase    : Boolean;
  33.  
  34.                     Constructor Init (LUN_SaveSet : String;
  35.                                       NewIOMode : tIOMode;
  36.                                       InfoLogFilename : String;
  37.                                       ErrorLogfilename : String;
  38.                                       DoResetFlag : Boolean;
  39.                                       DoEraseFlag : Boolean;
  40.                                       DoMemDisp   : Boolean);
  41.                     Destructor  Done; virtual;
  42.  
  43.                     Procedure TestTapeReady;
  44.                     Procedure TapeErrorCheck (Where : String);
  45.                     Procedure SetTapeSize (SizeStr : String);
  46.  
  47.                     { I/O primitives }
  48.                     Procedure OpenArchive; virtual;
  49.                     Procedure CloseArchive; virtual;
  50.                     Procedure ReadBlock; virtual;
  51.                     Procedure WriteBlock; virtual;
  52.                     Procedure SeekBlock (NewBlockNum : Longint); virtual;
  53.                   end;
  54.  
  55. implementation
  56.  
  57. Constructor TTapeArchiver.Init (LUN_SaveSet : String;
  58.                                NewIOMode : tIOMode;
  59.                                InfoLogFilename : String;
  60.                                ErrorLogfilename : String;
  61.                                DoResetFlag : Boolean;
  62.                                DoEraseFlag : Boolean;
  63.                                DoMemDisp   : Boolean);
  64. Var
  65.  Result  : Integer;
  66.  LUN     : Byte;
  67.  S,SS    : String;
  68. Begin
  69.  { Parameters }
  70.  { ... from Init }
  71.  IOMode := NewIOMode;
  72.  DoReset := DoResetFlag;
  73.  { ... presets }
  74.  TapeKBytes := 0;
  75.  DisplayFlag := False;
  76.  TotalSize := 0;
  77.  TotalFiles := 0;
  78.  KBytesThreshold := 5000;
  79.  Timeout := 15;
  80.  DoTime := True;
  81.  ArchiveName := 'Nothing';
  82.  Wordy := True;
  83.  DoErase := DoEraseFlag;
  84.  Val(Copy(LUN_SaveSet,1,Pos(':',LUN_SaveSet)-1),LUN,Result);
  85.  Delete (LUN_SaveSet,1,Pos(':',LUN_SaveSet));
  86.  DirectoryFilename := '#'+LUN_SaveSet+'.DIR';
  87.  Val(LUN_SaveSet,SaveSet,Result);
  88.  { Logfile }
  89.  New (ErrorLog,Init(ErrorLogfilename));
  90.  New (InfoLog,Init(InfoLogFilename));
  91.  { Data storage }
  92.  New (Block);
  93.  If Block=NIL Then Begin
  94.   ErrorLog^.Writelog ('Allocation of write block: out of memory');
  95.   Fail;
  96.  End;
  97.  New (FileBlock);
  98.  If FileBlock=NIL Then Begin
  99.   ErrorLog^.Writelog ('Allocation of read block: out of memory');
  100.   Dispose (Block);
  101.   Fail;
  102.  End;
  103.  FillChar (Block^,SizeOf(TBlock),0);
  104.  FillChar (FileBlock^,SizeOf(TBlock),0);
  105.  { Directory }
  106.  New (DirCollection,Init(20,20));
  107.  If DirCollection=NIL Then Begin
  108.   ErrorLog^.Writelog ('Allocation of directory: out of memory');
  109.   Dispose (Block);
  110.   Dispose (FileBlock);
  111.   Fail;
  112.  End;
  113.  { Tape }
  114.  New (Tape,Init(LUN));
  115.  If Tape=NIL Then Begin
  116.   ErrorLog^.Writelog ('Allocation of tape object: out of memory');
  117.   Dispose (Block);
  118.   Dispose (FileBlock);
  119.   Dispose (DirCollection,Done);
  120.   Fail;
  121.  End;
  122.  { Device inquiry }
  123.  Tape^.Inquiry;
  124.  If Wordy Then InfoLog^.Writelog ('['+Tape^.Info.Device+'] '+Tape^.Info.Product+' by '+Tape^.Info.Vendor);
  125.  { SCSI device found }
  126.  If NOT Tape^.Info.Valid Then Begin
  127.   ErrorLog^.Writelog ('Checking SCSI-device: no valid SCSI device found');
  128.   Dispose (Block);
  129.   Dispose (FileBlock);
  130.   Dispose (DirCollection,Done);
  131.   Dispose (Tape,Done);
  132.   Fail;
  133.  End;
  134.  { Open }
  135.  OpenArchive;
  136.  If Tape=NIL Then Begin
  137.   ErrorLog^.Writelog ('Initializing tape: operation unsuccessful');
  138.  End;
  139.  { Show memory information }
  140.  If DoMemDisp Then Begin
  141.   Str (MaxAvail,S);
  142.   Str ((MaxAvail DIV DirItemSize),SS);
  143.   Commas (S);
  144.   Commas (SS);
  145.   InfoLog^.Writelog ('There are '+S+' bytes free to handle '+SS+' files.');
  146.  End;
  147. End;
  148.  
  149. Destructor TTapeArchiver.Done;
  150. Var
  151.  S1,S2 : String;
  152. Begin
  153.  If Wordy And (TotalFiles>0) Then Begin
  154.   Str (TotalSize,S1);
  155.   Str (TotalFiles,S2);
  156.   InfoLog^.Writelog ('Processed '+S1+' bytes in '+S2+' files.');
  157.  End;
  158.  { Close }
  159.  CloseArchive;
  160.  { Data }
  161.  Dispose (Block);
  162.  Dispose (FileBlock);
  163.  Dispose (DirCollection,Done);
  164.  Dispose (Tape,Done);
  165.  Dispose (ErrorLog);
  166.  Dispose (InfoLog);
  167.  { Directory }
  168.  EraseDirectory;
  169. End;
  170.  
  171. { Return the number of physical blocks available in the tape of type }
  172. { 'SizeStr'. Each physical block holds 1 KB of data.                 }
  173. Procedure TTapeArchiver.SetTapeSize (SizeStr : String);
  174. Type
  175.  TSizes = Record
  176.            Name    : String[6];
  177.            Blocks  : Longint;
  178.           End;
  179. Const
  180.  Sizes = 9;
  181.  SizeArray : Array [1..Sizes] Of TSizes = (
  182.                                            (Name : 'P5-15';
  183.                                             Blocks: $ccd50),
  184.                                            (Name : 'P5-30';
  185.                                             Blocks: $18e880),
  186.                                            (Name : 'P5-60';
  187.                                             Blocks: $311ed0),
  188.                                            (Name : 'P5-90';
  189.                                             Blocks: $49ab40),
  190.                                            (Name : 'P6-15';
  191.                                             Blocks: $8c440),
  192.                                            (Name : 'P6-30';
  193.                                             Blocks: $118290),
  194.                                            (Name : 'P6-60';
  195.                                             Blocks: $22ff20),
  196.                                            (Name : 'P6-90';
  197.                                             Blocks: $347bc0),
  198.                                            (Name : 'P6-120';
  199.                                             Blocks: $45f840)
  200.                                           );
  201. Var
  202.  Counter : Byte;
  203. Begin
  204.  { Match descriptor }
  205.  SizeStr := Upper(SizeStr);
  206.  For Counter := 1 To Sizes Do Begin
  207.   If SizeArray[Counter].Name=SizeStr Then Begin
  208.    TapeKBytes := SizeArray[Counter].Blocks;
  209.    Exit;
  210.   End;
  211.  End;
  212.  { No match ... default to maximum size }
  213.  If Wordy Then InfoLog^.Writelog ('Cannot match tape descriptor for size determination.');
  214.  TapeKBytes := SizeArray[4].Blocks;
  215. End;
  216.  
  217. Procedure TTapeArchiver.TapeErrorCheck (Where : String);
  218. Var
  219.  Now   : Longint;
  220.  ATime : DateTime;
  221.  Dummy : Word;
  222. Begin
  223.  If Tape^.Status.Error Then Begin
  224.   Tape^.ParseStatus;
  225.   { Prepare current time }
  226.   GetTime (ATime.Hour,ATime.Min,ATime.Sec,Dummy);
  227.   GetDate (ATime.Year,ATime.Month,ATime.Day,Dummy);
  228.   PackTime(ATime,Now);
  229.   If DoTime Then ErrorLog^.Writelog ('@ '+TimeString(Now)+':');
  230.   { Text }
  231.   ErrorLog^.Writelog('['+Where+']: tape error detected');
  232.   ErrorLog^.Writelog(' ASPI  : '+Tape^.Status.ASPI);
  233.   ErrorLog^.Writelog(' Host  : '+Tape^.Status.Host);
  234.   ErrorLog^.Writelog(' Target: '+Tape^.Status.Target);
  235.   ErrorLog^.Writelog(' Sense : '+Tape^.Status.Sense);
  236.   If Tape^.Status.SenseExt<>'' Then ErrorLog^.Writelog('         '+Tape^.Status.SenseExt);
  237.  End;
  238. End;
  239.  
  240. Procedure TTapeArchiver.ReadBlock;
  241. Var
  242.  Result : Word;
  243. Begin
  244.  TestTapeReady;
  245.  Tape^.ReadData (Block,Blocksize);
  246.  TapeErrorCheck ('Reading');
  247.  { Update counters }
  248.  BlockOfs := 0;
  249.  Inc (BlockNum);
  250. End;
  251.  
  252. Procedure TTapeArchiver.WriteBlock;
  253. Begin
  254.  If BlockOfs<Blocksize Then FillChar(Block^[BlockOfs],Blocksize-BlockOfs,0);
  255.  TestTapeReady;
  256.  Tape^.WriteData (Block,Blocksize);
  257.  TapeErrorCheck ('Writing');
  258.  BlockOfs := 0;
  259.  Inc (BlockNum);
  260. End;
  261.  
  262. Procedure TTapeArchiver.SeekBlock (NewBlockNum : Longint);
  263. Begin
  264.  If (BlockNum+1)<>NewBlockNum Then Begin
  265.   TestTapeReady;
  266.   Tape^.LocateTape (Longint(StartBlock)+Longint(NewBlockNum));
  267.   TapeErrorCheck ('Seeking');
  268.   BlockNum := Longint(NewBlockNum)-1;
  269.  End;
  270.  ReadBlock;
  271. End;
  272.  
  273. Procedure TTapeArchiver.OpenArchive;
  274. Var
  275.  S: String;
  276. Begin
  277.  { Initial ready check }
  278.  If DoReset Then Tape^.ASPIReset;
  279.  If Wordy Then InfoLog^.Writelog ('Waiting for tape to come online');
  280.  TestTapeReady;
  281.  { Check for tape }
  282.  If Tape^.Status.TapeNotPresent Then Begin
  283.   ErrorLog^.Writelog ('Checking SCSI-device: no tape present');
  284.   Dispose (Tape,Done);
  285.   Exit;
  286.   Tape := NIL;
  287.  End;
  288.  { Check write protection }
  289.  If (IOMode=fWrite) AND (Tape^.Status.WriteProtectOn) Then Begin
  290.   ErrorLog^.Writelog ('Checking SCSI-device: write protect on');
  291.   Dispose (Tape,Done);
  292.   Exit;
  293.   Tape := NIL;
  294.  End;
  295.  { Set blocksize }
  296.  Tape^.ModeSelect(Blocksize);
  297.  TapeErrorCheck ('Mode select');
  298.  { Seek to end of n-th saveset: 1=stay, 2=skip 1, 3=skip 2, ... }
  299.  If SaveSet>1 Then Begin
  300.   Str (SaveSet,S);
  301.   If Wordy Then InfoLog^.Writelog ('Seeking to saveset #'+S);
  302.   TestTapeReady;
  303.   Tape^.SpaceFilemark (SaveSet-1);
  304.   TapeErrorCheck ('Spacing over filemarks');
  305.   If Tape^.Status.Error Then Begin
  306.    Dispose (Tape,Done);
  307.    Exit;
  308.    Tape := NIL;
  309.   End;
  310.  End;
  311.  { Erase if necessary, rewind and seek again }
  312.  If (IOMode=fWrite) AND DoErase Then Begin
  313.   If Wordy Then InfoLog^.Writelog ('Erasing tape (25 min/GByte)');
  314.   TestTapeReady;
  315.   Tape^.Erase;
  316.   TapeErrorCheck ('Erasing tape');
  317.   TestTapeReady;
  318.   Tape^.Rewind;
  319.   TapeErrorCheck ('Rewinding');
  320.   { Seek to end of n-th saveset: 1=stay, 2=skip 1, 3=skip 2, ... }
  321.   If SaveSet>1 Then Begin
  322.    Str (SaveSet,S);
  323.    If Wordy Then InfoLog^.Writelog ('Seeking to saveset #'+S);
  324.    TestTapeReady;
  325.    Tape^.SpaceFilemark (SaveSet-1);
  326.    TapeErrorCheck ('Spacing over filemarks');
  327.    If Tape^.Status.Error Then Begin
  328.     Dispose (Tape,Done);
  329.     Exit;
  330.     Tape := NIL;
  331.    End;
  332.   End;
  333.  End;
  334.  { Determine starting block }
  335.  TestTapeReady;
  336.  StartBlock := Tape^.TapePosition;
  337.  TapeErrorCheck ('Determining position');
  338.  { Prepare block and counters }
  339.  Case IOMode of
  340.   fRead:  Begin BlockNum := -1; ReadBlock; End;
  341.   fWrite: Begin BlockNum := 0; BlockOfs := 0; End;
  342.  End;
  343. End;
  344.  
  345. Procedure TTapeArchiver.CloseArchive;
  346. Var
  347.  CurrentBlock : Longint;
  348.  KBytesLeft : Longint;
  349.  KBytesUsed : Longint;
  350.  S,SS       : String;
  351. Begin
  352.  If Wordy Then InfoLog^.Writelog ('Closing tape and rewinding');
  353.  { In Write-Mode ? }
  354.  If IOMode=fWrite Then Begin
  355.   { Flush block }
  356.   If BlockOfs<>0 Then WriteBlock;
  357.   { End the archive with a filemark ... }
  358.   TestTapeReady;
  359.   Tape^.WriteFilemark (1);
  360.   TapeErrorCheck ('Writing filemark');
  361.  End;
  362.  { Calculate bytes left and output }
  363.  If (TapeKBytes<>0) And Wordy And (IOMode=fWrite) Then Begin
  364.   { Determine current block }
  365.   TestTapeReady;
  366.   CurrentBlock := Tape^.TapePosition;
  367.   TapeErrorCheck ('Determining position');
  368.   { Calculcate capacities }
  369.   KBytesLeft := TapeKBytes - CurrentBlock*(Blocksize DIV 1024) - SaveSet +1;
  370.   KBytesUsed := CurrentBlock*(Blocksize DIV 1024) + Saveset -1;
  371.   Str (KBytesLeft:9,S);
  372.   Commas (S);
  373.   Str (KBytesUsed:9,SS);
  374.   Commas (SS);
  375.   InfoLog^.Writelog ('Tape statistics: '+SS+' KBytes used / '+S+' KBytes free');
  376.   If (KBytesLeft<KBytesThreshold) Then ErrorLog^.Writelog ('Warning: Tape capacity is low!  ('+S+' KBytes free).');
  377.  End;
  378.  { ... and rewind. }
  379.  TestTapeReady;
  380.  Tape^.Rewind;
  381.  TapeErrorCheck ('Rewinding');
  382. End;
  383.  
  384. Procedure TTapeArchiver.TestTapeReady;
  385. Var
  386.   Hour,
  387.   Minute,
  388.   Second,
  389.   MSecond,
  390.   OldSecond,
  391.   MinuteInfo,
  392.   MinuteEnd,
  393.   CountDown : Word;
  394.   S         : String;
  395. Begin
  396.  { Quick check }
  397.  Tape^.TestUnitReady;
  398.  If Tape^.Status.Error Then Begin
  399.   { Check every second until timeout is reached }
  400.   Dos.GetTime (Hour,Minute,Second,MSecond);
  401.   MinuteEnd := (Minute + Timeout) MOD 60;
  402.   MinuteInfo := (Minute + 2) MOD 60;
  403.   OldSecond := Second;
  404.   Countdown := Timeout-2;
  405.   Repeat
  406.    Dos.GetTime (Hour,Minute,Second,MSecond);
  407.    If OldSecond<>Second Then Begin
  408.     OldSecond := Second;
  409.     Tape^.TestUnitReady;
  410.    End;
  411.    { Give the current status every minute }
  412.    If Minute=MinuteInfo Then Begin
  413.     Str (Countdown,S);
  414.     TapeErrorCheck ('Waiting for tape '+S+' more minutes');
  415.     MinuteInfo := (Minute + 1) MOD 60;
  416.     Dec (Countdown);
  417.    End;
  418.   Until ((NOT Tape^.Status.Error) OR (MinuteEnd=Minute));
  419.   { If still in error status, then halt program, i.e. there is nothing }
  420.   { we can do. }
  421.   If Tape^.Status.Error Then Begin
  422.    Str (Timeout,S);
  423.    ErrorLog^.Writelog ('Fatal error: tape not ready after '+S+' minutes');
  424.    Halt (1);
  425.   End;
  426.  End;
  427. End;
  428.  
  429. Begin
  430. End.
  431.